;; =============================================================================
;; test declarations parser

(in-package :oali.core)

;; generic signature
(defgeneric parse-test-decl (context test-id args))


;; utility method: dumps type information
(defun dump-type-info (context type-id)
  (let ((type-inst (existing-type context type-id))
	(stream *standard-output*))
    ;; write statement type
    (write-string (format nil "~a" (type-of type-inst)) stream)
    (write-string ": " stream)

    ;; write type contents as it is to be defined in C
    (if (and (typep type-inst 'p-type-proxy) (null (proxy-type type-inst)))
	(write-string "<undefined>" stream)
	(print-c type-inst stream)))
  (write-char #\Newline *standard-output*))

;; test: dump type information
(defmethod parse-test-decl (context (id (eql 'dump-type)) args)
  (destructuring-bind (type-id) args
    (dump-type-info context type-id)))


;; test: dump information about all the defined types
(defmethod parse-test-decl (context (id (eql 'dump-all-types)) args)
  (declare (ignore args))
  (format t "context types =~%")
  (maphash
   (lambda (key value)
     (declare (ignore value))           ; FIXME: value is a type instance - dump-type-info shall use it instead of a key
     (format t "~a:~20t" key)
     (dump-type-info context key))
   (types context))
  (format t "===============~%"))

;; helper function to be used in type (un)definition checkers
(defun type-defined-assert (context defined args)
  (destructuring-bind (type-id) args
    (let ((types (types context)))
      ;; (eq (null A) (null B)) <=> (xor A B); but xor is not a standard for all lisps
      (unless (eq (null defined) (null (gethash type-id types)))
	(error (format nil "type ~a has~a been defined"
		       type-id
		       (if defined " not" "")))))
    type-id))

;; test: undefine the type given (TO BE CAREFULLY USED)
(defmethod parse-test-decl (context (id (eql 'undefine-type)) args)
  (remhash (type-defined-assert context t args) (types context)))

;; test: type has been defined
(defmethod parse-test-decl (context (id (eql 'type-defined)) args)
  (type-defined-assert context t args))

;; test: type has not been defined
(defmethod parse-test-decl (context (id (eql 'type-undefined)) args)
  (type-defined-assert context nil args))

;; emits diagnostic message
(defmethod parse-test-decl (context (id (eql 'print)) args)
  (declare (ignore context))
  (destructuring-bind (message-str) args
    (write-string message-str *standard-output*)
    (write-char #\Newline *standard-output*)))
